(FILECREATED "30-MAY-83 15:25:29" {PHYLUM}<GABRIEL>TRIANG.;5 3271   

      changes to:  (VARS TRIANGCOMS)
		   (FNS LAST-POSITION TRY TEST TRIANG-INIT GOGOGO)

      previous date: "30-MAY-83 13:50:41" {PHYLUM}<GABRIEL>TRIANG.;1)


(* Copyright (c) 1983 by Xerox Corporation)

(PRETTYCOMPRINT TRIANGCOMS)

(RPAQQ TRIANGCOMS ((LOCALVARS . T)
		   (SPECVARS ANSWER FINAL DEEPCOUNTER)
		   (GLOBALVARS BOARD SEQUENCE A B C)
		   (FNS GOGOGO LAST-POSITION TRY TEST TRIANG-INIT)
		   (P (TRIANG-INIT))))
(DECLARE: DOEVAL@COMPILE DONTCOPY

(LOCALVARS . T)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(SPECVARS ANSWER FINAL DEEPCOUNTER)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS BOARD SEQUENCE A B C)
)
(DEFINEQ

(GOGOGO
  (LAMBDA (I)                                                (* JonL "30-MAY-83 13:48")
    (PROG ((ANSWER NIL)
	   (FINAL NIL))
          (RETURN (TRY I 1)))))

(LAST-POSITION
  (LAMBDA NIL                                                (* JonL "30-MAY-83 15:22")
    (OR (find I to 16 suchthat (EQ 1 (8AREF BOARD I)))
	0)))

(TRY
  (LAMBDA (I DEPTH)                                          (* JonL "30-MAY-83 15:18")
    (DECLARE (SPECVARS ANSWER FINAL)
	     (GLOBALVARS BOARD SEQUENCE A B C))
    (COND
      ((EQ DEPTH 14)
	(PROG ((LP (LAST-POSITION)))
	      (COND
		((MEMBER LP FINAL))
		(T (push FINAL LP))))
	(push ANSWER (CDR (LISTARRAY SEQUENCE)))
	T)
      ((AND (EQ 1 (8AREF BOARD (8AREF A I)))
	    (EQ 1 (8AREF BOARD (8AREF B I)))
	    (EQ 0 (8AREF BOARD (8AREF C I))))
	(8ASET 0 BOARD (8AREF A I))
	(8ASET 0 BOARD (8AREF B I))
	(8ASET 1 BOARD (8AREF C I))
	(8ASET I SEQUENCE DEPTH)
	(bind (DEPTH ←(ADD1 DEPTH)) for J from 0 to 36 until (TRY J DEPTH) do NIL)
	(8ASET 1 BOARD (8AREF A I))
	(8ASET 1 BOARD (8AREF B I))
	(8ASET 0 BOARD (8AREF C I))
	NIL))))

(TEST
  (LAMBDA NIL                                                (* JonL "30-MAY-83 15:18")
    (DECLARE (SPECVARS ANSWER FINAL)
	     (GLOBALVARS BOARD SEQUENCE A B C))
    (TRIANG-INIT)
    (PROG ((ANSWER NIL)
	   (FINAL NIL))
          (TRY 22 1)
          (RETURN (EQ 775 (LENGTH ANSWER))))))

(TRIANG-INIT
  (LAMBDA NIL                                                (* JonL "30-MAY-83 15:00")
    (SETQ BOARD (MAKEARRAY 16 (QUOTE ELEMENTTYPE)
			   (QUOTE BYTE)
			   (QUOTE INITIALELEMENT)
			   1))
    (ASET 0 BOARD 5)
    (SETQ SEQUENCE (MAKEARRAY 14 (QUOTE ELEMENTTYPE)
			      (QUOTE BYTE)
			      (QUOTE INITIALELEMENT)
			      255))
    (SETQ A
      (MAKEARRAY 37 (QUOTE ELEMENTTYPE)
		 (QUOTE BYTE)
		 (QUOTE INITIALCONTENTS)
		 (QUOTE (1 2 4 3 5 6 1 3 6 2 5 4 11 12 13 7 8 4 4 7 11 8 12 13 6 10 15 9 14 13 13 14 
			   15 9 10 6 0))))
    (SETQ B
      (MAKEARRAY 37 (QUOTE ELEMENTTYPE)
		 (QUOTE BYTE)
		 (QUOTE INITIALCONTENTS)
		 (QUOTE (2 4 7 5 8 9 3 6 10 5 9 8 12 13 14 8 9 5 2 4 7 5 8 9 3 6 10 5 9 8 12 13 14 8 
			   9 5 0))))
    (SETQ C
      (MAKEARRAY 37 (QUOTE ELEMENTTYPE)
		 (QUOTE BYTE)
		 (QUOTE INITIALCONTENTS)
		 (QUOTE (4 7 11 8 12 13 6 10 15 9 14 13 13 14 15 9 10 6 1 2 4 3 5 6 1 3 6 2 5 4 11 12 
			   13 7 8 4 0))))))
)
(TRIANG-INIT)
(PUTPROPS TRIANG COPYRIGHT ("Xerox Corporation" 1983))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (714 3180 (GOGOGO 724 . 904) (LAST-POSITION 906 . 1089) (TRY 1091 . 1886) (TEST 1888 . 
2206) (TRIANG-INIT 2208 . 3178)))))
STOP